﻿(****************************************************************************
 * 
 *  Bistro FSharp Extensions Copyright © 2003-2009 Hill30 Inc
 *
 *  This file is part of Bistro Framework.
 *
 *  Bistro FSharp Extensions is free software: you can redistribute it and/or modify
 *  it under the terms of the GNU Lesser General Public License as published by
 *  the Free Software Foundation, either version 3 of the License, or
 *  (at your option) any later version.
 *
 *  Bistro FSharp Extensions is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU Lesser General Public License for more details.
 *
 *  You should have received a copy of the GNU Lesser General Public License
 *  along with Bistro FSharp Extensions.  If not, see <http://www.gnu.org/licenses/>.
 *  
 ***************************************************************************)
#light

namespace Bistro.FS

module Controller =

    open System
    open System.Xml
    open System.Web
    open System.Reflection
    open System.Collections.Generic

    open Microsoft.FSharp.Quotations
    open Microsoft.FSharp.Reflection

    open Bistro
    open Bistro.Configuration
    open Bistro.Controllers
    open Bistro.Controllers.Dispatch
    open Bistro.Controllers.Descriptor

    open Bistro.FS.Inference

    open Bistro.FS.Definitions

    type FormData = {
        func_parm_name: string
        record_type: Type
        autopassthrough: bool
        record_fields: string list
        record_constructor: ConstructorInfo
    }
    
    let process_form_data name parm_type autopassthrough = { 
        func_parm_name = name
        record_type = parm_type
        autopassthrough = autopassthrough
        record_fields = Array.map (fun (prop: PropertyInfo) -> prop.Name) <| FSharpType.GetRecordFields(parm_type) |> List.ofArray
        record_constructor = parm_type.GetConstructors().[0]
        }
        
    
    /// descriptor record for storing additional, f# specific, info
    type ExtendedDescriptor = {
        signature: (string * Type * Wrapper) list
        ret: (string * Type * Wrapper) list
        form: string list
        form_parms: FormData list
        provides: string list
        depends: string list
        requires: string list
        session_out: string list
        request: string list
        parms: string list
        info: MethodInfo
    }
    
    /// intermediate descriptor record for decomposing marker unions
    type ShortDescriptor = {
        hard_dep: string list
        soft_dep: string list
        session: string list
        request: string list
        form: string list
        form_parms: FormData list
    }

    type Handler(application: Application) = 
        let try_get (d: IDictionary<_,_>) key =
            if d.ContainsKey key then
                d.[key]
            else null

        let exists l v = List.exists ((=) v) l

        member x.Manager with get() = (application.ManagerFactory.GetManagerInstance()) :?> Manager
        
        interface IControllerHandler with
            member x.GetControllerInstance (info, context, requestContext) = 
                let fsDescriptor, (ret_accessor: obj -> obj array) = x.Manager.GetSignature (info.BindPoint.Controller)

                // return a shell controller. this controller uses signature and ret_signature to 
                // pull data out of the requestContext and supply it as a parameter list to the 
                // function we're wrapping, and then place its return values back onto the context                
                { new IController with
                    member y.Reusable with get() = false
                    member y.Stateful with get() = false
                    member y.Initialize() = ()
                    member y.Recycle() = ()
                    
                    member y.GlobalHandle with get() = fsDescriptor.info :> MemberInfo

                    member y.ProcessRequest (httpContext, requestContext) =
                        let parm_list =
                            Array.ofList fsDescriptor.signature |>
                            Array.map (fun parm -> 
                                        let name, tp, path = parm
                                        if tp.IsAssignableFrom(typeof<IExecutionContext>) then
                                            requestContext :> obj
                                        else
                                            match fsDescriptor.form_parms |> 
                                                    List.tryFind (fun elem -> elem.func_parm_name = name && elem.record_type = tp) with
                                            | Some form_data -> 
                                                form_data.record_constructor.Invoke (
                                                    Array.ofList <| 
                                                    List.map (fun (propname: string) -> 
                                                                (context.Request.Form.[propname]) :> obj) form_data.record_fields)
                                            | None ->
                                                wrap <|
                                                    if name |> exists fsDescriptor.parms then
                                                        (try_get info.Parameters name) :> obj
                                                    elif name |> exists fsDescriptor.form then
                                                        context.Request.Form.[name] :> obj
                                                    elif not ((requestContext :> System.Collections.IDictionary).Contains name) then
                                                        context.Session.[name]
                                                    else
                                                        requestContext.[name]
                                                <| path)
                        
                        let ret_val = fsDescriptor.info.Invoke(null, parm_list)
                        fsDescriptor.ret |> 
                        ((List.ofArray <| ret_accessor ret_val) |>
                         List.iter2 (fun a b ->
                                        let v = a
                                        let name, _, wrapper = b
                                        // we need to unwrap all outbound fields, so that we can
                                        // intermix f# and non f# controllers
                                        if name |> exists fsDescriptor.session_out then
                                            httpContext.Session.[name] <- unwrap v wrapper
                                        else
                                            requestContext.[name] <- unwrap v wrapper))

                        List.iter (fun data -> 
                                    if data.autopassthrough then
                                        List.iter (fun (propname: string) -> requestContext.[propname] <- context.Request.Form.[propname]) <|
                                        List.filter (fun elem -> not <| requestContext.Contains(elem)) data.record_fields
                                    else ()) fsDescriptor.form_parms
                }
                
            member x.ReturnController (controller, context, requestContext) = ()       

    and Manager (application: Application, section: SectionHandler) = 
        inherit ControllerManager (application)
        
        let ctx = typeof<IExecutionContext>
        let logger = application.LoggerFactory.GetLogger(typeof<Manager>)
        
        //TODO: think through run-time updates of this 
        let mutable signatures = Map.empty
        
        /// generate a Dictionary<'a, 'b> from the list. list elements are 
        /// converted into keys with def as the value
        let make_dict (list: 'a list) (def: 'b) =
            List.fold (fun (state: Dictionary<'a, 'b>) elem -> 
                                state.Add(elem,def)
                                state
                                ) (new Dictionary<'a, 'b>()) list
        
        /// scans through each of the supplied lists, stopping and returning true 
        /// when it encounters a list containing the value
        let rec any_have value = function
        | h::t -> if List.exists ((=) value) h then true else any_have value t
        | [] -> false

        /// recursively peels off outer markers of scope/directionality            
        let rec decompose param_list identify_forms state (a: string * Type) =
            let name, parm_type = a

            if  param_list = [] || not ([param_list] |> any_have name) then
                // rules are
                //      if it's in the list of parameters, we don't worry about it (this is wrong - make parameters available to context)
                //      if Option then it's a depends
                //      if Session, it's session
                //      if Form then form
                //      if random generic, we don't know what to do with it (this is also wrong - need to handle arbitrary generics as non-markers)
                //      if it's the context type, it's skipped
                //      if it's none of the above, then
                //          if it's been marked as session
                //              then if it's marked as depends, do nothing, otherwise it's a required field
                //          if it's been marked as form then do nothing
                //          if it's been marked as a depends it's a request field only, otherwise it's a required request field
                if isSupportedMarkerType parm_type then
                    (name, get_generic parm_type) |>
                        decompose param_list identify_forms
                            (match parm_type with 
                            | OptionMarker inner -> { state with soft_dep = name :: state.soft_dep }
                            | SessionMarker inner -> { state with session = name :: state.session }
                            | FormMarker inner when identify_forms -> { state with form = name :: state.form }
                            | _ -> raise (new ApplicationException(sprintf "%A is not a known resource marker" parm_type)))
                else
                    if parm_type.IsAssignableFrom ctx then
                        state // this is the context parameter. skip.
                    else
                        let is_depends = [state.soft_dep] |> any_have name
                        match Array.tryPick 
                                (fun (attr: obj) -> Some (attr :?> FormDataAttribute)) 
                                (parm_type.GetCustomAttributes(typeof<FormDataAttribute>, false)) with
                        | Some attr when FSharpType.IsRecord parm_type -> 
                            let data = process_form_data name parm_type attr.Autopassthrough
                            { state with 
                                form_parms = data :: state.form_parms 
                                request = (if data.autopassthrough then data.record_fields else []) @ state.request }
                        | _ ->
                            if [state.session] |> any_have name then
                                if is_depends then state 
                                else { state with hard_dep = name :: state.hard_dep}
                            elif [state.form] |> any_have name then
                                state
                            elif is_depends then
                                { state with request = name :: state.request }
                            else
                                { state with request = name :: state.request; hard_dep = state.hard_dep @ [name] }
            else
                state
            
        let dedupe l = List.ofSeq <| Set.ofList l

        /// builds a ControllerDescriptor based on a function signature.     
        /// signature and ret are list of string * Type describing the 
        /// input and output parameters of the function we're dealing with.
        ///
        /// rules are:
        ///     for function parameters ->
        ///     straight types are considered Required Request
        ///     option types are considered DependsOn Request
        ///     session types are considered Required Session
        ///     option session types are considered DependsOn Session
        ///
        ///     for function return values ->
        ///     option types are handled, but have no impact. 
        ///     session types are considered Provides Session
        ///     straight types are considered Provides Request
        let load (info: MethodInfo) signature ret =
            // kludgy, but we just want to get at the bind points right now...
            let bind_attrs = 
                info.GetCustomAttributes(typeof<BindAttribute>, false) |>
                Array.map (fun elem -> elem :?> BindAttribute)
            
            let empty_descriptor = ControllerDescriptor.CreateDescriptorRaw((info :> MemberInfo), null, null, null, null, null, null, null, bind_attrs, logger)
            let parameter_fields = 
                [for bind_point in empty_descriptor.Targets do
                    for parameter_field in bind_point.ParameterFields.Keys -> parameter_field]
                    
            let empty_descriptor = 
                { hard_dep = []; soft_dep = []; session = []; request = []; form = []; form_parms = []; }
                
            let input =
                List.fold (decompose parameter_fields true) empty_descriptor signature

            // for the returns, we only care about whether they're marked as session or request.
            // additionally, we'll treat the "requireds" list as the "provides" list, as those
            // will be fields that aren't marked with anything. 
            let output =
                List.fold (decompose parameter_fields false) empty_descriptor ret
                
            // note that we're splicing together the hard and soft dependencies of the output
            // for the provides list, as well as the session fields on both and the request
            // fields on both. session and request fields are meant to be a listing of all
            // fields of that scope, both inbound and outbound. 
            
            // the filtering of requires/provides is done to behave closer to the c# implementation
            // in c#, a field can be marked as 'requires', and be taken in, updated, and placed 
            // back on the context without creating an explicit 'provides' record. in f#, 
            // directionality is infered from whether the resource is in the input, output or both
            // and will cause recursion if not filtered
            let fsDescriptor = { 
                signature = List.map (fun elem -> 
                                        let name, tp = elem
                                        name, tp, precomputeWrap <| snd elem) signature
                ret = List.map (fun elem -> 
                                        let name, tp = elem
                                        name, tp, precomputeUnwrap <| snd elem) ret
                form = input.form
                form_parms = input.form_parms
                requires = 
                    dedupe input.hard_dep |> 
                    List.filter (fun elem -> not (List.exists ((=) elem) output.hard_dep)) |>
                    List.filter (fun elem -> not (List.exists ((=) elem) output.soft_dep))
                provides = dedupe (output.hard_dep @ output.soft_dep)
                depends = 
                    dedupe input.soft_dep |>
                    List.filter (fun elem -> not (List.exists ((=) elem) output.hard_dep)) |>
                    List.filter (fun elem -> not (List.exists ((=) elem) output.soft_dep))
                // we're working the request list into the session list and vice versa (for inptus)
                // because in f# we're willing to unify the namespaces. it'll give us cleaner
                // descriptor semantics
                session_out = dedupe output.session
                request = dedupe (input.session @ input.request @ output.request)
                parms = dedupe parameter_fields; info = info }

            (fsDescriptor,
                ControllerDescriptor.CreateDescriptorRaw(
                    (info :> MemberInfo), 
                    fsDescriptor.depends, 
                    fsDescriptor.requires, 
                    fsDescriptor.provides, 
                    null, 
                    make_dict fsDescriptor.form (info :> MemberInfo), 
                    make_dict (input.request @ input.session @ output.session) (info :> MemberInfo), 
                    make_dict fsDescriptor.request (info :> MemberInfo), 
                    bind_attrs,
                    logger))

        /// Generates a list of PropertyInfo objects for accessing the positional 
        /// elements of a tuple
        let unfold_tuple (tuple_type: Type) =
            // the type may be a tuple or a straight variable. as a result, we can't (and shouldn't)
            // expose the internals. all we're going to do is make available a function of one element
            // and leave the details in here.
            if (FSharpType.IsTuple tuple_type) then
                FSharpValue.PreComputeTupleReader tuple_type
            elif typeof<Void> = tuple_type then
                fun v -> Array.empty
            else
                fun v -> [|v|]
        
        /// Retrieves the signature associated with the descriptor
        member internal x.GetSignature descriptor = Map.find descriptor signatures
        
        /// Invokes the standard register controller method, and also stores the signature of 
        /// the controller.
        member private x.register_controller fsDescriptor bDescriptor =
            signatures <- (Map.add bDescriptor (fsDescriptor, (unfold_tuple fsDescriptor.info.ReturnType)) signatures)
            x.RegisterController bDescriptor
            
        override x.LoadAssembly assm =
            try
                base.LoadAssembly(assm)
            with | _ as e -> System.Console.Error.WriteLine(e)
            get_assembly_info [assm]
            |> List.iter (fun a ->
                            snd a |>
                            List.iter (fun f ->
                                match f with 
                                | Controller (info, signature, ret) ->
                                    match ret with
                                    | None -> ()
                                    | Some s -> 
                                        let fsDescriptor, bDescriptor = load info signature s
                                        x.register_controller fsDescriptor bDescriptor
                                        ))
    
    type HandlerFactory(application: Application, section: Bistro.Configuration.SectionHandler) =
        let default_factory = new Bistro.Controllers.HandlerFactory(application, section)
        
        interface IControllerHandlerFactory with
            member x.CreateControllerHandler descriptor = 
                match descriptor.ControllerType with 
                | :? Type -> default_factory.CreateControllerHandler(descriptor)
                | _ -> new Handler(application) :> IControllerHandler
                
    type ManagerFactory(application: Application, section: Bistro.Configuration.SectionHandler) =
        inherit ControllerManagerFactory(application, section)
            override x.GetInstanceImpl(application) = 
                let mgr = new Manager(application, section) 
                ignore <| mgr.Load()
                mgr :> IControllerManager
            